home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / simple1a / chat.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-07-02  |  4.9 KB  |  158 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form frmChat 
  5.    Caption         =   "Chat"
  6.    ClientHeight    =   3915
  7.    ClientLeft      =   165
  8.    ClientTop       =   735
  9.    ClientWidth     =   4590
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3915
  12.    ScaleWidth      =   4590
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MSComctlLib.StatusBar sbrChat 
  15.       Align           =   2  'Align Bottom
  16.       Height          =   375
  17.       Left            =   0
  18.       TabIndex        =   1
  19.       Top             =   3540
  20.       Width           =   4590
  21.       _ExtentX        =   8096
  22.       _ExtentY        =   661
  23.       Style           =   1
  24.       _Version        =   393216
  25.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  26.          NumPanels       =   1
  27.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  28.             AutoSize        =   1
  29.             Object.Width           =   7594
  30.          EndProperty
  31.       EndProperty
  32.    End
  33.    Begin MSWinsockLib.Winsock sckTCP 
  34.       Left            =   120
  35.       Top             =   3000
  36.       _ExtentX        =   741
  37.       _ExtentY        =   741
  38.       _Version        =   393216
  39.    End
  40.    Begin VB.TextBox txtChat 
  41.       Height          =   2895
  42.       Left            =   0
  43.       MultiLine       =   -1  'True
  44.       ScrollBars      =   2  'Vertical
  45.       TabIndex        =   0
  46.       Top             =   0
  47.       Width           =   4215
  48.    End
  49.    Begin VB.Menu mnuConnect 
  50.       Caption         =   "&Connect!"
  51.    End
  52.    Begin VB.Menu mnuDisconnect 
  53.       Caption         =   "&Disconnect!"
  54.    End
  55. Attribute VB_Name = "frmChat"
  56. Attribute VB_GlobalNameSpace = False
  57. Attribute VB_Creatable = False
  58. Attribute VB_PredeclaredId = True
  59. Attribute VB_Exposed = False
  60. Option Explicit
  61. Dim mlngBytes As Long
  62. 'Start out listening for connection
  63. 'requests
  64. Private Sub Form_Load()
  65.     'Set the port to listen on
  66.     sckTCP.LocalPort = 1002
  67.     'Begin listening
  68.     sckTCP.Listen
  69.     'Update status bar
  70.     ShowText "Listening"
  71. End Sub
  72. Private Sub Form_Resize()
  73.     txtChat.Width = Me.ScaleWidth
  74.     txtChat.Height = Me.ScaleHeight - sbrChat.Height
  75.     sbrChat.Panels(1).Width = Me.ScaleWidth - 300
  76. End Sub
  77. Private Sub mnuConnect_Click()
  78.     Dim strRemoteHost As String
  79.     'Get the name of a computer to connect to
  80.     strRemoteHost = InputBox("Enter name or IP address of computer " & _
  81.         "to connect to.", vbOKCancel)
  82.     'Exit if cancelled
  83.     If strRemoteHost = "" Then Exit Sub
  84.     'Close any open connections
  85.     sckTCP.Close
  86.     'Set the name of the computer to connect to
  87.     sckTCP.RemoteHost = strRemoteHost
  88.     'Specify a port number on remote host
  89.     sckTCP.RemotePort = 1002
  90.     'This seems to prevent some TCP errors
  91.     DoEvents
  92.     'Request the connection
  93.     sckTCP.Connect
  94. End Sub
  95. Private Sub mnuDisconnect_Click()
  96.     sckTCP.Close
  97.     DoEvents
  98.     sckTCP.Listen
  99.     ShowText "Listen"
  100. End Sub
  101. Private Sub sckTCP_Close()
  102.     ShowText "Close"
  103.     'When connection by remote machine, go back to listening
  104.     sckTCP.Close
  105.     sckTCP.Listen
  106.     ShowText "Listen"
  107. End Sub
  108. Private Sub sckTCP_Connect()
  109.     ShowText "Connected"
  110. End Sub
  111. Private Sub sckTCP_ConnectionRequest(ByVal requestID As Long)
  112.     sckTCP.Close
  113.     sckTCP.Accept requestID
  114.     ShowText "Accepting request from " & sckTCP.RemoteHostIP
  115. End Sub
  116. Private Sub sckTCP_DataArrival(ByVal bytesTotal As Long)
  117.     Dim strText As String
  118.     'Get data
  119.     sckTCP.GetData strText
  120.     'Display data received
  121.     txtChat = txtChat & ">>" & strText & vbCrLf
  122.     'Move cursor to end
  123.     txtChat.SelStart = Len(txtChat)
  124.     ShowText "Bytes received: " & bytesTotal
  125. End Sub
  126. 'Display error information
  127. Private Sub sckTCP_Error(ByVal Number As Integer, _
  128.     Description As String, ByVal Scode As Long, _
  129.     ByVal Source As String, ByVal HelpFile As String, _
  130.     ByVal HelpContext As Long, CancelDisplay As Boolean _
  131.     ShowText "Error " & Number & " " & Description
  132. End Sub
  133. Private Sub sckTCP_SendComplete()
  134.     ShowText "Bytes sent: " & mlngBytes
  135. End Sub
  136. Private Sub sckTCP_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
  137.     'Record number of bytes sent
  138.     mlngBytes = bytesSent
  139. End Sub
  140. Private Sub txtChat_KeyPress(KeyAscii As Integer)
  141.     Static strSend As String
  142.     'Make sure there is a connection
  143.     If sckTCP.State <> sckConnected Then Exit Sub
  144.     'Send data when user presses Enter
  145.     If KeyAscii = Asc(vbCr) Then
  146.         'Send the string
  147.         sckTCP.SendData strSend
  148.         'Clear the variable
  149.         strSend = ""
  150.     Else
  151.         'Keep track of what is being typed
  152.         strSend = strSend & Chr(KeyAscii)
  153.     End If
  154. End Sub
  155. Sub ShowText(Text As String)
  156.     sbrChat.Panels(1).Text = Text
  157. End Sub
  158.